home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmf1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  9.7 KB  |  249 lines
  1. (*===========================================================================*)
  2. (* Find/Get distribution list                                                *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1991, 1992 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. (*===========================================================================*)
  9. (* Find a msg given the number                                               *)
  10. (*===========================================================================*)
  11.  
  12. FUNCTION find_msg(msg_no : WORD) : msg_index_ptr;
  13.  
  14.   VAR
  15.     msg_index_current : msg_index_ptr;
  16.  
  17.   BEGIN;
  18.  
  19.     msg_index_current := msg_index_start;
  20.  
  21.     WHILE (msg_index_current <> NIL)
  22.                   AND (msg_index_current^.msg_i_mb.msg_number < msg_no) DO
  23.       msg_index_current := msg_index_current^.msg_i_next;
  24.  
  25.     IF (msg_index_current = NIL)
  26.                    OR (msg_index_current^.msg_i_mb.msg_number <> msg_no)
  27.                    OR (NOT check_hidden(msg_index_current)) THEN
  28.       find_msg := NIL
  29.     ELSE
  30.       find_msg := msg_index_current;
  31.  
  32.   END;
  33.  
  34. (*===========================================================================*)
  35. (* If a distribution list is not in memory, go get it                        *)
  36. (*===========================================================================*)
  37.  
  38. FUNCTION find_dist_list (i_ptr  : msg_index_ptr) : msg_d_ptr;
  39.  
  40.   TYPE
  41.     buffer_type = RECORD
  42.                    CASE BYTE OF
  43.                      0: (buffer_msg : msg_block);
  44.                      1: (buffer_dis : msg_dist_block_type);
  45.                    END;
  46.  
  47.   VAR
  48.     buffer  : buffer_type;
  49.     rec_no  : WORD;
  50.     i       : WORD;
  51.     j       : BYTE;
  52.     new_blk : msg_d_ptr;
  53.     new_ptr : ^msg_d_ptr;
  54.  
  55.   {$UNDEF DEBUG_GET_DIST_1}
  56.  
  57.   BEGIN;
  58.  
  59.     {$IFDEF DEBUG_GET_DIST_1}
  60.       WRITELN('Dist get = ', i_ptr^.msg_i_mb.msg_number,
  61.                            ' ', i_ptr^.msg_i_dis = NIL);
  62.       trace_data('GETDL', i_ptr^.msg_i_mb.msg_number, i_ptr^.msg_i_dis, '');
  63.     {$ENDIF}
  64.  
  65.     (*-----------------------------------------------------------------------*)
  66.     (* If the distribution list does not exist then we are done              *)
  67.     (*-----------------------------------------------------------------------*)
  68.  
  69.     IF (i_ptr^.msg_i_mb.msg_flag AND mf_fwd_list) = 0 THEN
  70.       BEGIN;
  71.         {$IFDEF POINT_CHK}
  72.           test_pointer(NIL);
  73.         {$ENDIF}
  74.         {$IFNDEF POINT_CHK}
  75.           EXIT;
  76.         {$ENDIF}
  77.       END;
  78.  
  79.     (*-----------------------------------------------------------------------*)
  80.     (* Get pointer to first block.  We also need a pointer to where the      *)
  81.     (* pointer was obtained                                                  *)
  82.     (*-----------------------------------------------------------------------*)
  83.  
  84.     new_blk := i_ptr^.msg_i_dis;
  85.     new_ptr := ADDR(i_ptr^.msg_i_dis);
  86.  
  87.     {$IFDEF POINT_CHK}
  88.       test_pointer(i_ptr);
  89.       IF new_blk <> NIL THEN
  90.         test_pointer(new_blk);
  91.     {$ENDIF}
  92.  
  93.     (*-----------------------------------------------------------------------*)
  94.     (* See if we have a route block here.  If we are supposed to have one    *)
  95.     (* and don't, then just turn it off.  Otherwise use route_block          *)
  96.     (*-----------------------------------------------------------------------*)
  97.  
  98.     IF ((i_ptr^.msg_i_mb.msg_flag AND mf_disrout) <> 0) THEN
  99.       IF new_blk = NIL THEN
  100.         BEGIN;
  101.           {$IFDEF POINT_CHK}
  102.             test_pointer(NIL);
  103.           {$ENDIF}
  104.           i_ptr^.msg_i_mb.msg_flag := i_ptr^.msg_i_mb.msg_flag
  105.                                                           AND (NOT mf_disrout);
  106.         END
  107.       ELSE
  108.         BEGIN;
  109.           new_ptr := ADDR(i_ptr^.msg_i_dr^.msg_dr_dblk);
  110.           new_blk := new_ptr^;
  111.           {$IFDEF POINT_CHK}
  112.             test_pointer(new_blk);
  113.           {$ENDIF}
  114.         END;
  115.  
  116.     (*-----------------------------------------------------------------------*)
  117.     (* If the distribution list is already in memory, we are done            *)
  118.     (*-----------------------------------------------------------------------*)
  119.  
  120.     IF new_blk <> NIL THEN
  121.       BEGIN;
  122.         {$IFDEF POINT_CHK}
  123.           test_pointer(new_blk);
  124.         {$ENDIF}
  125.         find_dist_list := new_blk;
  126.         EXIT;
  127.       END;
  128.  
  129.     (*-----------------------------------------------------------------------*)
  130.     (* Get number of record that we want                                     *)
  131.     (*-----------------------------------------------------------------------*)
  132.  
  133.     rec_no := i_ptr^.msg_i_record + 1;
  134.  
  135.     (*-----------------------------------------------------------------------*)
  136.     (* Grab the lock so we can open the message file                         *)
  137.     (*-----------------------------------------------------------------------*)
  138.  
  139.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  140.  
  141.     (*-----------------------------------------------------------------------*)
  142.     (* Open the msg file                                                     *)
  143.     (*-----------------------------------------------------------------------*)
  144.  
  145.     RESET(msg_file);
  146.  
  147.     (*-----------------------------------------------------------------------*)
  148.     (* Get the file size                                                     *)
  149.     (*-----------------------------------------------------------------------*)
  150.  
  151.     i := FILESIZE(msg_file);
  152.  
  153.     (*-----------------------------------------------------------------------*)
  154.     (* Verify gotten size versus calculated size and the position wanted     *)
  155.     (*-----------------------------------------------------------------------*)
  156.  
  157.     IF (i > next_record_no) OR (rec_no > next_record_no) THEN
  158.       BEGIN;
  159.  
  160.         (*-------------------------------------------------------------------*)
  161.         (* The file sizes do not agree... PANIC                              *)
  162.         (*-------------------------------------------------------------------*)
  163.  
  164.         dump_reason('Next record number computed and actual do not agree');
  165.         dump_reason('or seek malfunction in GET_DIST');
  166.         dump_reason('Computed =' + w2c(next_record_no) + ' Actual   ='
  167.                                  + w2c(i) + ' Seek     =' + w2c (rec_no));
  168.         dump_all;
  169.         RUNERROR(msg_runerr);
  170.  
  171.       END;
  172.  
  173.     (*-----------------------------------------------------------------------*)
  174.     (* Set Position                                                          *)
  175.     (*-----------------------------------------------------------------------*)
  176.  
  177.     SEEK(msg_file, rec_no);
  178.  
  179.     (*-----------------------------------------------------------------------*)
  180.     (* Read in distribution list into buffer                                 *)
  181.     (*-----------------------------------------------------------------------*)
  182.  
  183.     READ(msg_file, buffer.buffer_msg);
  184.  
  185.     (*-----------------------------------------------------------------------*)
  186.     (* Done with the file!                                                   *)
  187.     (*-----------------------------------------------------------------------*)
  188.  
  189.     {$I-}
  190.     CLOSE(msg_file);
  191.     {$I+}
  192.     i := IORESULT;
  193.  
  194.     (*-----------------------------------------------------------------------*)
  195.     (* Release the interrupt lock                                            *)
  196.     (*-----------------------------------------------------------------------*)
  197.  
  198.     free_semaphore(semaphore_interrupts);
  199.  
  200.     (*-----------------------------------------------------------------------*)
  201.     (* Get number of items in the array                                      *)
  202.     (*-----------------------------------------------------------------------*)
  203.  
  204.     i := buffer.buffer_dis.msg_d_no;
  205.  
  206.     (*-----------------------------------------------------------------------*)
  207.     (* Validate                                                              *)
  208.     (*-----------------------------------------------------------------------*)
  209.  
  210.     IF i > msg_dist_max THEN
  211.       BEGIN;
  212.         dump_reason('MF11 Invalid distribution # -- ' + w2c(i)
  213.                     + ' -- #' + w2c(i_ptr^.msg_i_mb.msg_number));
  214.         dump_trace;
  215.         dump_msg(i_ptr);
  216.         RUNERROR(msg_runerr);
  217.       END;
  218.  
  219.     (*-----------------------------------------------------------------------*)
  220.     (* Clear the flags in the distribution list                              *)
  221.     (*-----------------------------------------------------------------------*)
  222.  
  223.     FOR j := 1 TO i DO
  224.       WITH buffer.buffer_dis.msg_d_array[j] DO
  225.         msg_d_flag := msg_d_flag AND NOT (df_fwd_select OR df_fwd_process);
  226.  
  227.     (*-----------------------------------------------------------------------*)
  228.     (* Get the memory size needed to make it fit                             *)
  229.     (*-----------------------------------------------------------------------*)
  230.  
  231.     i := 1 + i * SIZEOF(msg_dist_entry_type);
  232.  
  233.     GETMEM(new_blk, i);
  234.  
  235.     (*-----------------------------------------------------------------------*)
  236.     (* Copy the data into the area                                           *)
  237.     (*-----------------------------------------------------------------------*)
  238.  
  239.     MOVE(buffer, new_blk^, i);
  240.  
  241.     (*-----------------------------------------------------------------------*)
  242.     (* Update the pointer                                                    *)
  243.     (*-----------------------------------------------------------------------*)
  244.  
  245.     new_ptr^ := new_blk;
  246.     find_dist_list := new_blk;
  247.  
  248.   END;
  249.